home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / pasmail.com / MAIL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-06-24  |  10.5 KB  |  468 lines
  1.  
  2. PROGRAM mail_label;
  3.  
  4. USES CRT,DOS,PRINTER;
  5.  
  6. const
  7.   top = 300;
  8.  
  9. TYPE
  10.   REC = RECORD
  11.     FNAME : STRING[20];
  12.     LNAME : STRING[20];
  13.     ad1   : string[20];
  14.     ad2   : string[20];
  15.     CITY  : STRING[20];
  16.     STATE : STRING[20];
  17.     ZIP   : STRING[10];
  18.     phone : string[10];
  19.     END; (* RECORDS*)
  20.   DATABANK = ARRAY [1..TOP] OF REC;
  21.  
  22.  
  23. VAR
  24.   ALLDATA : DATABANK;
  25.   I , MAX: INTEGER;
  26.   CH : CHAR;
  27.   saved : boolean;
  28. (*******************************************************************)
  29. (*                BEGIN PROCEDURES AND FUNCTIONS                   *)
  30. (*******************************************************************)
  31.  
  32. procedure sort;
  33. (**********************************)
  34. procedure shell(var alldata:databank;n : integer);
  35. var
  36.   gap,i,j,k : integer;
  37. (**********************************)
  38. procedure switch(var a,b : rec);
  39. var
  40.   c : rec;
  41. begin
  42.   c:=a;
  43.   a:=b;
  44.   b:=c;
  45. end;
  46. (**********************************)
  47. begin
  48.   gap := n div 2;
  49.   while (gap > 0) do
  50.     begin
  51.       for i:=(gap+1) to n do
  52.         begin
  53.           j:=i - gap;
  54.           while (j > 0) do
  55.             begin
  56.               k:=j + gap;
  57.               if alldata[j].lname < alldata[k].lname then
  58.                 j:=0
  59.               else
  60.                 begin
  61.                 if ((alldata[j].lname = alldata[k].lname) and (alldata[j].fname <= alldata[k].fname)) then j:=0
  62.                 else
  63.                   switch(alldata[j],alldata[k]);
  64.                 end;
  65.               j:=j-gap
  66.             end;
  67.         end;
  68.       gap:=gap div 2;
  69.       end;
  70.     end;
  71. begin
  72. shell(alldata,max);
  73. end;
  74.  
  75. (*********************************************************)
  76.  
  77. PROCEDURE BLANKONE(ONEE : REC;VAR ONE : REC)  ;
  78. BEGIN
  79.    ONEE.FNAME :='';
  80.    ONEE.LNAME :='';
  81.    ONEE.CITY  :='';
  82.    ONEE.AD1 := '';
  83.    ONEE.AD2 := '';
  84.    ONEE.PHONE:='';
  85.    ONEE.STATE :='';
  86.    ONEE.ZIP   :='';
  87. ONE:=ONEE;
  88. END;
  89.  
  90. (*==================================================================*)
  91.  
  92. FUNCTION HOWMANYINALLDATA : INTEGER;
  93.  
  94. VAR
  95.   TEMP:INTEGER;
  96.  
  97. BEGIN
  98.   TEMP:=0;
  99.   i:=0;
  100.   WHILE TEMP=0 DO
  101.     BEGIN
  102.       I:=I + 1;
  103.       IF ALLDATA[I].FNAME = ''  THEN TEMP:=I;
  104.     END;
  105.   HOWMANYINALLDATA:=TEMP-1;
  106. END;
  107.  
  108. (*==================================================================*)
  109.  
  110. PROCEDURE io(inp:boolean);
  111. VAR
  112.   ch:char;
  113.   exist : string;
  114.   filen:string;
  115.   OFILE : FILE OF DATABANK;
  116. BEGIN
  117.   clrscr;
  118.   if inp = false then
  119.   begin
  120.     ch:='Y';
  121.     sort;
  122.     WRITE('Enter the name of the file to save. Press Enter to Exit. ');
  123.     readln(filen);
  124.     repeat
  125.     exist:='';
  126.     exist:=fsearch(filen,'');
  127.     if filen = '' then exit;
  128.     if length(exist)<>0 then
  129.       begin
  130.         clrscr;
  131.         sound(1000);
  132.         delay(500);
  133.         nosound;
  134.         writeln(filen,' allready exists do you want to overwrite ? (Y/N) ');
  135.         ch:=upcase(readkey);
  136.         if ch='N' then
  137.         begin
  138.           write('Enter new Name : ');
  139.           readln(filen);
  140.           end;
  141.       end;
  142.     until ((ch = 'Y') or (exist = ''));
  143.     (*$I-*)
  144.     ASSIGN(OFILE,filen);
  145.     REWRITE(OFILE);
  146.   end;
  147.   if inp = true then
  148.   begin
  149.     WRITE('Enter the name of the file to load. Press Enter to Exit. ');
  150.     readln(filen);
  151.     if filen = '' then exit;
  152.     (*$I-*)
  153.     ASSIGN(OFILE,filen);
  154.     reset(OFILE);
  155.   end;
  156.   if ioresult <> 0 then
  157.     begin
  158.       clrscr;
  159.       writeln('Disk Error  or file not found !!!');
  160.       sound(1000);
  161.       delay(1000);
  162.       nosound;
  163.       exit;
  164.       (*$I+*)
  165.     end;
  166.   (*$i+*)
  167.   if inp = false then WRITE(OFILE,ALLDATA) else read(ofile,alldata);
  168.   CLOSE(OFILE);
  169.   saved:=true;
  170. END;
  171.  
  172. (*==================================================================*)
  173.  
  174. PROCEDURE VIEWONSCREEN;
  175. var
  176.   dest : string;
  177.   where : text;
  178.   temp : char;
  179. BEGIN
  180.  textbackground(black);
  181.  CLRSCR;
  182.  write('Enter 1 to print to the Screen, or 2 to print to the printer. ');
  183.  readln(temp);
  184.  case temp of
  185.     '1' : dest:='con';
  186.     '2' : dest:='lst';
  187.  end (* end of case *);
  188.  assign(where,dest);
  189.  rewrite(where);
  190.  clrscr;
  191.  FOR I:=1 TO MAX DO
  192.    BEGIN
  193.      WITH ALLDATA[I] DO
  194.      BEGIN
  195.      WRITELN(where,FNAME,' ', LNAME);
  196.      WRITELN(where,AD1);
  197.      WRITELN(where,AD2);
  198.      WRITELN(where,CITY,' , ',STATE,' , ',ZIP);
  199.      WRITELN(where,PHONE);
  200.      READLN;
  201.      END;
  202.    END;
  203. close(where);
  204. END;
  205.  
  206. (*==================================================================*)
  207.  
  208. PROCEDURE ADD;
  209. VAR
  210.   TEMP : STRING;
  211. BEGIN
  212.   CLRSCR;
  213.   IF MAX=TOP THEN
  214.     BEGIN
  215.       WRITELN('ARRAY FULL CAN''T ADD.');
  216.       DELAY(1000);
  217.       EXIT;
  218.     END;
  219.   MAX:=MAX+1;
  220.   WITH ALLDATA[max] DO
  221.   BEGIN
  222.     WRITE('ENTER L. NAME ''Q'' TO QUIT. ');
  223.     READLN(LNAME);
  224.     IF ((LNAME = 'Q') or (lname = 'q')) THEN
  225.       begin
  226.         max:=0;
  227.         EXIT;
  228.       end;
  229.     saved:=false;
  230.     WRITE('ENTER FIRST NAME: ');
  231.     READLN(FNAME);
  232.     WRITE('ADDRESS LINE 1: ');
  233.     READLN(AD1);
  234.     WRITE('ADDRESS LINE 2: ');
  235.     READLN(AD2);
  236.     WRITE('CITY: ');
  237.     READLN(CITY);
  238.     WRITE('STATE: ');
  239.     READLN(STATE);
  240.     WRITE('ZIP: ');
  241.     READLN(ZIP);
  242.     WRITE('PHONE: ');
  243.     READLN(PHONE);
  244.   END;
  245. sort;
  246. END;
  247.  
  248. (*==================================================================*)
  249.  
  250. PROCEDURE DELETE;
  251. VAR
  252.   i : integer;
  253.   ch : char;
  254.   TEMP1,TEMP2:STRING;
  255.   FOUND:BOOLEAN;
  256.   temp:integer;
  257. BEGIN
  258.   CLRSCR;
  259.   WRITEln('Press the space bar for the next name, or Enter to choose the name, or q to Quit');
  260.   i:=1;
  261.   found := false;
  262.   repeat
  263.     gotoxy(1,3);
  264.     write(alldata[i].lname,',',alldata[i].fname);
  265.     ch:=upcase(readkey);
  266.     if ch='Q' then exit;
  267.     if ch=#13 then found := true;
  268.     i:=i+1;
  269.     if i> max then i:=1;
  270.   until found = true;
  271.   if i=1 then i:=2;
  272.   i:=i-1;
  273.   BLANKONE(ALLDATA[I],ALLDATA[I]);
  274.   for temp:=i to max-1 do
  275.   alldata[temp]:=alldata[temp+1];
  276.   blankone(alldata[max],alldata[max]);
  277.   max:=max-1;
  278.   I:=I+1;
  279.   sort;
  280. END;
  281.  
  282. (*==================================================================*)
  283.  
  284. procedure change;
  285. VAR
  286.   TEMP1,TEMP2:STRING;
  287.   FOUND:BOOLEAN;
  288.   ch : char;
  289.   temp:integer;
  290. BEGIN
  291.   CLRSCR;
  292.   WRITEln('Press the space bar for the next name, or Enter to choose the name, or q to Quit');
  293.   i:=1;
  294.   found := false;
  295.   repeat
  296.     gotoxy(1,3);
  297.     write(alldata[i].lname,',',alldata[i].fname);
  298.     ch:=upcase(readkey);
  299.     if ch='Q' then exit;
  300.     if ch=#13 then found := true;
  301.     i:=i+1;
  302.     if i> max then i:=1;
  303.   until found = true;
  304.   if i=1 then i:=2;
  305.   i:=i-1;
  306.   repeat
  307.   WITH ALLDATA[I] DO
  308.     BEGIN
  309.       clrscr;
  310.       WRITEln('1. L. NAME: ',lname);
  311.       WRITEln('2. FIRST NAME: ',fname);
  312.       WRITEln('3. ADDRESS LINE 1: ',ad1);
  313.       WRITEln('4. ADDRESS LINE 2: ',ad2);
  314.       WRITEln('5. CITY: ',city);
  315.       WRITEln('6. STATE: ',state);
  316.       WRITEln('7. ZIP: ',zip);
  317.       WRITEln('8. PHONE: ',phone);
  318.       writeln('9. To Exit');
  319.     END;
  320.   writeln('What one to change ?');
  321.   ch:=readkey;
  322.   with alldata[i] do
  323.     begin
  324.       case ch of
  325.         '1' : begin
  326.                 writeln('Enter new L. Name: ');
  327.                 readln(lname);
  328.                 saved:=false;
  329.               end;
  330.         '2' : begin
  331.                 writeln('Enter new F.Name: ');
  332.                 readln(fname);
  333.                 saved:=false;
  334.               end;
  335.         '3' : begin
  336.                 writeln('Enter new Address line 1: ');
  337.                 readln(ad1);
  338.                 saved:=false;
  339.               end;
  340.         '4' : begin
  341.                 writeln('Enter new Address Line 2: ');
  342.                 readln(ad2);
  343.                 saved:=false;
  344.                end;
  345.         '5' : begin
  346.                 writeln('Enter new City: ');
  347.                 readln(city);
  348.                 saved:=false;
  349.               end;
  350.         '6' : begin
  351.                 writeln('Enter new State: ');
  352.                 readln(state);
  353.                 saved:=false;
  354.               end;
  355.         '7' : begin
  356.                 writeln('Enter new Zip: ');
  357.                 readln(zip);
  358.                 saved:=false;
  359.                end;
  360.         '8' : begin
  361.                 writeln('Enter new Phone number: ');
  362.                 readln(phone);
  363.                 saved:=false;
  364.               end;
  365.            end;
  366.          end;
  367.       until ch = '9';
  368.     i:=1+1;
  369. sort;
  370. end;
  371.  
  372. (*==================================================================*)
  373.  
  374. PROCEDURE MAKE_INITIAL;
  375. BEGIN
  376.   MAX:=0;
  377.   ADD;
  378. END;
  379.  
  380. (*==================================================================*)
  381.  
  382. PROCEDURE PLABEL;
  383. BEGIN
  384.   FOR I:=1 TO MAX DO
  385.    BEGIN
  386.      WITH ALLDATA[I] DO
  387.      BEGIN
  388.        WRITELN(LST,FNAME,' ',LNAME);
  389.        WRITELN(LST,AD1);
  390.        IF AD2<>'' THEN WRITELN(LST,AD2);
  391.        WRITELN(LST,CITY,' , ',STATE,' , ',ZIP);
  392.        IF AD2='' THEN WRITELN(LST);
  393.        writeln(lst);
  394.        WRITELN(LST);
  395.      END;
  396.    END;
  397. END;
  398.  
  399. (**************************************************************************)
  400. (*                        BEGIN MAIN PROGRAM                              *)
  401. (**************************************************************************)
  402.  
  403. BEGIN
  404.   FOR I:=1 TO TOP DO
  405.     BLANKONE(ALLDATA[I],ALLDATA[I]);
  406.   MAX:=0;
  407.   I:=1;
  408.   saved:=true;
  409.   textbackground(blue);
  410.   textcolor(white);
  411.   CLRSCR;
  412.   REPEAT
  413.     textbackground(blue);
  414.   textcolor(white);
  415.     clrscr;
  416.     max:=howmanyinalldata;
  417.     if max <> 0 then
  418.     begin
  419.     WRITELN('Enter ''S'' To Save the List.');
  420.     WRITELN('Enter ''L'' To Load the List.');
  421.     WRITELN('Enter ''A'' To Add to the List.');
  422.     WRITELN('Enter ''D'' To Delete from the List.');
  423.     WRITELN('Enter ''C'' To Change an address.');
  424.     WRITELN('Enter ''V'' To View the List.');
  425.     WRITELN('Enter ''P'' To Print the labels.');
  426.     WRITELN('Enter ''Q'' To QUIT');
  427.     writeln;
  428.     if saved=false then
  429.       writeln('Please save your work.');
  430.     CH:=READKEY;
  431.     CH:=UPCASE(CH);
  432.     CASE CH OF
  433.       'V': VIEWONSCREEN;
  434.       'S': io(false);
  435.       'L': io(true);
  436.       'A': ADD;
  437.       'P': PLABEL;
  438.       'D': DELETE;
  439.       'C': change;
  440.       END;
  441.   end;
  442.   if max = 0 then
  443.   begin
  444.   TEXTBACKGROUND(BLUE);
  445.     CLRSCR;
  446.     TEXTCOLOR(WHITE);
  447.     WRITE('Enter ''M'' To Make the First Record ');
  448.     TEXTCOLOR(10+BLINK);
  449.     WRITELN('ONLY.');
  450.     TEXTCOLOR(WHITE);
  451.     WRITELN('Enter ''S'' To Save the List.');
  452.     WRITELN('Enter ''L'' To Load the List.');
  453.     WRITELN('Enter ''Q'' To QUIT');
  454.     CH:=READKEY;
  455.     CH:=UPCASE(CH);
  456.     CASE CH OF
  457.       'M':Make_initial;
  458.       'S': io(false);
  459.       'L': io(true);
  460.       END;
  461.   clrscr;
  462.   end;
  463.   UNTIL CH='Q';
  464.   if saved=false then io(false);
  465. textbackground(black);
  466. textcolor(white);
  467. clrscr;
  468. END.